home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
001
/
pibmdos.arc
/
PIBMDOS.PAS
next >
Wrap
Pascal/Delphi Source File
|
1986-09-27
|
37KB
|
700 lines
(*--------------------------------------------------------------------------*)
(* PIBMDOS.PAS --- Multitasker interface routines *)
(*--------------------------------------------------------------------------*)
(* *)
(* Author: Philip R. Burns *)
(* *)
(* Date: Version 1.0: January, 1986. DoubleDos support. *)
(* Version 2.0: April, 1986. Add DesqView support. *)
(* Version 3.0: July, 1986. Add TopView/Windows support. *)
(* Version 3.1: September, 1986. Update for TaskView support. *)
(* *)
(* Systems: MS DOS or PC DOS with DoubleDos/DesqView/TopView/Windows *)
(* installed. *)
(* *)
(* History: These routines provide a simple interface for PibTerm *)
(* with SoftLogic's DoubleDos multitasking executive, *)
(* Quarterdeck's DesqView multitasker, IBM's TopView, *)
(* MicroSoft's Windows, and Sunny Hill's TaskView. *)
(* (Windows is handled as a Topview-emulating product. This is *)
(* also true for TaskView and DesqView, but those programs do *)
(* not require the explicit screen updates TopView requires. *)
(* *)
(* If you have another multitasker, you should be able to *)
(* replace these routines fairly easily with similar-acting *)
(* ones for your multitasker. Use the global types defined *)
(* for MultiTasker and MultiTaskerType. *)
(* *)
(* With DoubleDos, it is necessary to reobtain the display buffer *)
(* address every time the screen memory is written to. With *)
(* DesqView, this is unnecessary. With TopView and Windows, *)
(* it is necessary to inform them that the screen has changed. *)
(* TaskView works like DesqView. *)
(* *)
(* There are routines for suspending/unsuspending timesharing *)
(* included here, but the only actual code provided is for *)
(* DoubleDos. This is because it is rarely necessary to freeze *)
(* programs in the TopView-like group, but it IS necessary for *)
(* DoubleDos to ensure that, when a large screen update is being *)
(* performed, no task switch occurs during the middle of the *)
(* update. *)
(* *)
(*--------------------------------------------------------------------------*)
(* *)
(* Please leave messages on Gene Plantz's BBS (312) 882 4145 *)
(* or Ron Fox's BBS (312) 940 6496. *)
(* *)
(*--------------------------------------------------------------------------*)
(*----------------------------------------------------------------------*)
(* Color_Screen_Active --- Determine if color or mono screen *)
(*----------------------------------------------------------------------*)
FUNCTION Color_Screen_Active : BOOLEAN;
(*----------------------------------------------------------------------*)
(* *)
(* Function: Color_Screen_Active *)
(* *)
(* Purpose: Determines if color or mono screen active *)
(* *)
(* Calling Sequence: *)
(* *)
(* Color_Active := Color_Screen_Active : BOOLEAN; *)
(* *)
(* Color_Active --- set to TRUE if the color screen is *)
(* active, FALSE if the mono screen is *)
(* active. *)
(* *)
(* Calls: INTR *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Regs : RegPack;
BEGIN (* Color_Screen_Active *)
Regs.Ax := 15 SHL 8;
INTR( $10 , Regs );
Color_Screen_Active := ( Regs.Al <> 7 );
End (* Color_Screen_Active *);
(*----------------------------------------------------------------------*)
(* Current_Video_Mode --- Determine current video mode setting *)
(*----------------------------------------------------------------------*)
FUNCTION Current_Video_Mode: INTEGER;
(*----------------------------------------------------------------------*)
(* *)
(* Function: Current_Video_Mode *)
(* *)
(* Purpose: Gets current video mode setting from system *)
(* *)
(* Calling Sequence: *)
(* *)
(* Current_Mode := Current_Video_Mode : INTEGER; *)
(* *)
(* Current_Mode --- set to integer representing current *)
(* video mode inherited from system. *)
(* *)
(* Calls: INTR *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Regs : RegPack;
BEGIN (* Current_Video_Mode *)
Regs.Ax := 15 SHL 8;
INTR( $10 , Regs );
Current_Video_Mode := Regs.Al;
End (* Current_Video_Mode *);
(*----------------------------------------------------------------------*)
(* Get_Screen_Address --- Get address of current screen *)
(*----------------------------------------------------------------------*)
PROCEDURE Get_Screen_Address( VAR Actual_Screen : Screen_Ptr );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Get_Screen_Address *)
(* *)
(* Purpose: Gets screen address for current type of display *)
(* *)
(* Calling Sequence: *)
(* *)
(* Get_Screen_Address( VAR Actual_Screen : Screen_Ptr ); *)
(* *)
(* Actual_Screen --- pointer whose value receives the *)
(* current screen address. *)
(* *)
(* Calls: Color_Screen_Active *)
(* PTR *)
(* TimeSharingActive *)
(* *)
(* Remarks: *)
(* *)
(* This routine assumes that 'IsTimeSharingActive' has already *)
(* been called so that the value of 'Virtual_Screen' is defined. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Regs: RegPack;
BEGIN (* Get_Screen_Address *)
CASE MultiTasker OF
DoubleDos: BEGIN
Regs.Ax := $EC00;
MsDos( Regs );
Actual_Screen := PTR( Regs.Es, 0 );
END;
(* For TopView family, if graphics mode, *)
(* we must return actual screen address, *)
(* not virtual buffer address. The *)
(* virtual buffer is only for the *)
(* text modes. *)
TaskView,
TopView,
MSWindows,
DesqView: IF ( Current_Video_Mode <> HiRes_GraphMode ) THEN
Actual_Screen := Virtual_Screen
ELSE
Actual_Screen := PTR( Color_Screen_Address , 0 );
ELSE
IF Color_Screen_Active THEN
Actual_Screen := PTR( Color_Screen_Address , 0 )
ELSE
Actual_Screen := PTR( Mono_Screen_Address , 0 );
END (* CASE *);
END (* Get_Screen_Address *);
(*--------------------------------------------------------------------------*)
(* IsTimeSharingActive --- Checks if multitasker is active *)
(*--------------------------------------------------------------------------*)
FUNCTION IsTimeSharingActive : BOOLEAN;
(*--------------------------------------------------------------------------*)
(* *)
(* Function: IsTimeSharingActive *)
(* *)
(* Purpose: Checks if multitasker is active *)
(* *)
(* Calling Sequence: *)
(* *)
(* Ts_On := IsTimeSharingActive : BOOLEAN; *)
(* *)
(* Ts_On --- TRUE if multitasker is active. *)
(* *)
(* Calls: MsDos *)
(* *)
(*--------------------------------------------------------------------------*)
VAR
Regs : RegPack;
(*--------------------------------------------------------------------------*)
FUNCTION Get_TopView_Screen_Address : BOOLEAN;
VAR
SegS : INTEGER;
SegO : INTEGER;
BEGIN (* Get_TopView_Screen_Address *)
Regs.Di := 0;
Regs.Ax := $FE00;
IF Color_Screen_Active THEN
Regs.Es := Color_Screen_Address
ELSE
Regs.Es := Mono_Screen_Address;
SegO := 0;
SegS := Regs.Es;
INTR( $10 , Regs );
Virtual_Screen := PTR( Regs.Es , Regs.Di );
Get_TopView_Screen_Address := ( ( Regs.Es <> SegS ) OR ( Regs.Di <> SegO ) );
END (* Get_TopView_Screen_Address *);
(*--------------------------------------------------------------------------*)
BEGIN (* IsTimeSharingActive *)
(* Assume timesharing not active *)
IsTimeSharingActive := FALSE;
MultiTasker := MultiTasker_None;
(* Get initial screen address *)
IF Color_Screen_Active THEN
Virtual_Screen := PTR( Color_Screen_Address , 0 )
ELSE
Virtual_Screen := PTR( Mono_Screen_Address , 0 );
(* If DDos is active, $E4 should *)
(* return a non-zero value in Al *)
Regs.Ax := $E400;
MsDos( Regs );
IF ( Regs.Al <> 0 ) THEN
BEGIN
IsTimeSharingActive := TRUE;
MultiTasker := DoubleDos;
EXIT;
END;
(* See if DesqView is active. *)
(* We do a time/date call with *)
(* DESQ as date. If DesqView is *)
(* active, this will be accepted. *)
(* If not, it returns as invalid. *)
(* While we're at it, get the *)
(* display buffer address, which *)
(* never changes. *)
Regs.Ax := $2B01;
Regs.Cx := $4445; (*'DE'*)
Regs.Dx := $5351; (*'SQ'*)
MsDos( Regs );
IF ( Regs.Al <> $FF ) THEN
IF Get_TopView_Screen_Address THEN
BEGIN
IsTimeSharingActive := TRUE;
MultiTasker := DesqView;
EXIT;
END;
(* Check for TaskView or TopView. We do *)
(* a request for a TopView version number. *)
(* If BX comes back $0001, this must be *)
(* TaskView. Anything non-zero indicates *)
(* TopView or a compatible program. *)
Regs.Ax := $1022;
Regs.Bx := 0;
INTR( $15 , Regs );
IF ( Regs.Bx <> 0 ) THEN
BEGIN
IF ( Regs.Bx = 1 ) THEN
MultiTasker := TaskView
ELSE
MultiTasker := TopView;
IF ( NOT Get_TopView_Screen_Address ) THEN
MultiTasker := Multitasker_None
ELSE
IsTimeSharingActive := TRUE;
END;
END (* IsTimeSharingActive *);
(*--------------------------------------------------------------------------*)
(* TurnOnTimeSharing --- allow timesharing to proceed *)
(*--------------------------------------------------------------------------*)
PROCEDURE TurnOnTimeSharing;
(*--------------------------------------------------------------------------*)
(* *)
(* Procedure: TurnOnTimeSharing; *)
(* *)
(* Purpose: Activates timesharing *)
(* *)
(* Calling Sequence: *)
(* *)
(* TurnOnTimeSharing; *)
(* *)
(* Calls: MsDos *)
(* *)
(*--------------------------------------------------------------------------*)
VAR
Regs : RegPack;
BEGIN (* TurnOnTimeSharing *)
CASE MultiTasker OF
(* If DDos is active, $EB turns *)
(* on timesharing *)
DoubleDos: BEGIN
Regs.Ax := $EB00;
MsDos( Regs );
END;
ELSE;
END (* CASE *);
END (* TurnOnTimeSharing *);
(*--------------------------------------------------------------------------*)
(* TurnOffTimeSharing --- suspend timesharing under DoubleDos *)
(*--------------------------------------------------------------------------*)
PROCEDURE TurnOffTimeSharing;
(*--------------------------------------------------------------------------*)
(* *)
(* Procedure: TurnOffTimeSharing; *)
(* *)
(* Purpose: Suspends timesharing *)
(* *)
(* Calling Sequence: *)
(* *)
(* TurnOffTimeSharing; *)
(* *)
(* Calls: MsDos *)
(* *)
(*--------------------------------------------------------------------------*)
VAR
Regs : RegPack;
BEGIN (* TurnOffTimeSharing *)
CASE MultiTasker OF
(* If DDos is active, $EA suspends *)
(* timesharing *)
DoubleDos: BEGIN
Regs.Ax := $EA00;
MsDos( Regs );
END;
ELSE;
END (* CASE *);
END (* TurnOffTimeSharing *);
(*--------------------------------------------------------------------------*)
(* GiveAwayTime --- gives away time slices to other task *)
(*--------------------------------------------------------------------------*)
PROCEDURE GiveAwayTime( NSlices : INTEGER );
(*--------------------------------------------------------------------------*)
(* *)
(* Procedure: GiveAwayTime; *)
(* *)
(* Purpose: Gives away time slices to other tasks *)
(* *)
(* Calling Sequence: *)
(* *)
(* GiveAwayTime( NSlices : INTEGER ); *)
(* *)
(* NSlices --- # of slices (55 ms) to give away, if DoubleDos. *)
(* For other multitaskers, the entire remaining *)
(* time-slice is given up. *)
(* *)
(* Calls: MsDos *)
(* *)
(*--------------------------------------------------------------------------*)
VAR
Regs : RegPack;
BEGIN (* GiveAwayTime *)
CASE MultiTasker OF
(* Function EE gives time to other part. *)
DoubleDos: BEGIN
Regs.Ah := $EE;
Regs.Al := NSlices;
MsDos( Regs );
END;
(* Int 15H for TopView family products *)
DesqView,
TopView,
MSWindows,
TaskView: BEGIN
Regs.Ax := $1000;
INTR( $15 , Regs );
END;
ELSE;
END (* CASE *);
END (* GiveAwayTime *);
(*--------------------------------------------------------------------------*)
(* Sync_Screen --- Synchronizes multitasker screen with hardware screen *)
(*--------------------------------------------------------------------------*)
PROCEDURE Sync_Screen( S_Pos: INTEGER; NChars : INTEGER );
(*--------------------------------------------------------------------------*)
(* *)
(* Procedure: Sync_Screen; *)
(* *)
(* Purpose: Synchronizes multitasker and hardware screens *)
(* *)
(* Calling Sequence: *)
(* *)
(* Sync_Screen( S_Pos : INTEGER; NChars: INTEGER ); *)
(* *)
(* Calls: INTR *)
(* *)
(* Remarks: *)
(* *)
(* This facility is required by the TopView-family products. *)
(* *)
(*--------------------------------------------------------------------------*)
VAR
Regs : RegPack;
Daddr : Screen_Ptr;
BEGIN (* Sync_Screen *)
IF ( MultiTasker IN [TopView,MSWindows] ) THEN
WITH Regs DO
BEGIN
Regs.Es := SEG( Virtual_Screen^ );
Regs.Di := OFS( Virtual_Screen^ ) + S_Pos - 1;
Regs.Cx := NChars SHL 1;
Regs.Ah := $FF;
INTR( $10 , Regs );
END;
END (* Sync_Screen *);
(*--------------------------------------------------------------------------*)
(* Sync_Entire_Screen --- Synchronizes multitasker screen with hardware *)
(*--------------------------------------------------------------------------*)
PROCEDURE Sync_Entire_Screen;
(*--------------------------------------------------------------------------*)
(* *)
(* Procedure: Sync_Entire_Screen; *)
(* *)
(* Purpose: Synchronizes multitasker and hardware screens *)
(* *)
(* Calling Sequence: *)
(* *)
(* Sync_Entire_Screen; *)
(* *)
(* Calls: INTR *)
(* *)
(* Remarks: *)
(* *)
(* This facility is used by the TopView-family products when the *)
(* entire screen has been updated. *)
(* *)
(*--------------------------------------------------------------------------*)
VAR
Regs : RegPack;
BEGIN (* Sync_Entire_Screen *)
IF ( MultiTasker IN [TopView,MSWindows] ) THEN
WITH Regs DO
BEGIN
Regs.Es := SEG( Virtual_Screen^ );
Regs.Di := OFS( Virtual_Screen^ );
Regs.Cx := Screen_Length SHR 1;
Regs.Ah := $FF;
INTR( $10 , Regs );
END;
END (* Sync_Entire_Screen *);
(*----------------------------------------------------------------------*)
(* WriteSXY --- Write text string to specified row/column *)
(*----------------------------------------------------------------------*)
PROCEDURE WriteSXY( S: AnyStr; X: INTEGER; Y: INTEGER; Color: INTEGER );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: WriteSXY *)
(* *)
(* Purpose: Writes text string at specified row and column *)
(* position on screen. *)
(* *)
(* Calling Sequence: *)
(* *)
(* WriteSXY( S: AnyStr; X: INTEGER; Y: INTEGER; Color: INTEGER );*)
(* *)
(* S --- String to be written *)
(* X --- Column position to write string *)
(* Y --- Column position to write string *)
(* Color --- Color in which to write string *)
(* *)
(* Calls: None *)
(* *)
(* Remarks: This routine is based in part on one written by *)
(* Dennis Brain. *)
(* *)
(*----------------------------------------------------------------------*)
BEGIN (* WriteSXY *)
(* Freeze screen for DoubleDos *)
IF ( MultiTasker = DoubleDos ) THEN
BEGIN
TurnOffTimeSharing;
Get_Screen_Address( Virtual_Screen );
END;
INLINE(
$1E { PUSH DS ;Save DS}
{;}
{; Check if we're going to use BIOS}
{;}
/$A0/>Write_Screen_Memory { MOV AL,[<Write_Screen_Memory] ;See if we're writing to screen memory}
/$D0/$D8 { RCR AL,1 ;}
/$73/$5B { JNC BIOS ;No -- skip to BIOS code}
{;}
{; Set up for direct screen write.}
{; Get row position and column positions, and offset in screen buffer.}
{;}
/$8B/$46/<Y { MOV AX,[BP+<Y] ;AX = Row}
/$48 { DEC AX ;Row to 0..24 range}
/$B9/$04/$00 { MOV CX,$0004 ;CL = 4; CH = 0}
/$D3/$E0 { SHL AX,CL ;AX = Row * 16}
/$89/$C3 { MOV BX,AX ;Sore in BX}
/$D1/$E0 { SHL AX,1 ;AX = Row * 32}
/$D1/$E0 { SHL AX,1 ;AX = Row * 64}
/$01/$D8 { ADD AX,BX ;AX = (Row * 64) + (Row * 16)}
{ ; = Row * 80}
/$8B/$5E/<X { MOV BX,[BP+<X] ;BX = Column}
/$4B { DEC BX ;Col to 0..79 range}
/$01/$D8 { ADD AX,BX ;AX = (Row * 80) + Col}
/$D1/$E0 { SHL AX,1 ;Account for attribute bytes}
/$89/$C7 { MOV DI,AX ;Move result into DI}
/$8D/$76/<S { LEA SI,[BP+<S] ;DS:SI will point to S[0]}
/$8B/$16/>Virtual_Screen+2 { MOV DX,[>Virtual_Screen+2];DX = Base address of screen}
/$8E/$C2 { MOV ES,DX ;ES:DI points to Base:Row,Col}
/$A0/>Wait_For_Retrace { MOV AL,[<Wait_For_Retrace] ;Grab this before changing DS}
/$8C/$D2 { MOV DX,SS ;Move SS...}
/$8E/$DA { MOV DS,DX ; into DS}
/$8A/$0C { MOV CL,[SI] ;CL = Length(S)}
/$E3/$72 { JCXZ Exit ;If string empty, Exit}
/$46 { INC SI ;DS:SI points to S[1]}
/$8A/$66/<Color { MOV AH,[BP+<Color] ;AH = Attribute}
/$FC { CLD ;Set direction to forward}
/$D0/$D8 { RCR AL,1 ;If Snow is False...}
/$73/$1C { JNC Mono ; use "Mono" routine}
{;}
{; Color routine (used only when Wait_For_Retrace is True) **}
{;}
/$BA/>CRT_Status { MOV DX,>CRT_Status ;Point DX to CGA status port}
/$AC {GetNext: LODSB ;Load next character into AL}
{ ; AH already has Attr}
/$89/$C3 { MOV BX,AX ;Store video word in BX}
/$B4/$09 { MOV AH,$09 ;Move horizontal & vertical}
{ ; retrace mask into AH}
/$FA { CLI ;No interrupts now}
/$EC {WaitH: IN AL,DX ;Get 6845 status}
/$D0/$D8 { RCR AL,1 ;Wait for horizontal}
/$72/$FB { JC WaitH ; retrace}
/$EC {WaitV: IN AL,DX ;Get 6845 status again}
/$20/$E0 { AND AL,AH ;Wait for vertical}
/$74/$FB { JZ WaitV ; retrace}
/$89/$D8 { MOV AX,BX ;Move word back to AX...}
/$AB { STOSW ; and then to screen}
/$FB { STI ;Allow interrupts}
/$E2/$EA { LOOP GetNext ;Get next character}
/$E9/$4D/$00 { JMP Exit ;Done}
{;}
{; Mono routine (used whenever Wait_For_Retrace is False) **}
{;}
/$AC {Mono: LODSB ;Load next character into AL}
{ ; AH already has Attr}
/$AB { STOSW ;Move video word into place}
/$E2/$FC { LOOP Mono ;Get next character}
/$E9/$46/$00 { JMP Exit ;Done}
{;}
{; Use BIOS to display string (if Wrie_To_Screen is False) **}
{;}
/$8A/$76/<Y {Bios: MOV DH,[BP+<Y] ;Get starting row}
/$FE/$CE { DEC DH ;Drop by one for BIOS}
/$8A/$56/<X { MOV DL,[BP+<X] ;Get starting column}
/$FE/$CA { DEC DL ;Drop for indexing}
/$FE/$CA { DEC DL ;}
/$8D/$76/<S { LEA SI,[BP+<S] ;DS:SI will point to S[0]}
/$8C/$D0 { MOV AX,SS ;Move SS...}
/$8E/$D8 { MOV DS,AX ; into DS}
/$8A/$0C { MOV CL,[SI] ;CL = Length(S)}
/$E3/$2F { JCXZ Exit ;If string empty, Exit}
/$46 { INC SI ;DS:SI points to S[1]}
/$52 { PUSH DX ;Save X and Y}
/$1E { PUSH DS ;Save DS:SI}
/$56 { PUSH SI ;}
/$FC { CLD ;Forward direction}
{;}
/$51 {Bios1: PUSH CX ;Push length}
/$B4/$02 { MOV AH,2 ;BIOS Position cursor}
/$B7/$00 { MOV BH,0 ;Page zero}
/$59 { POP CX}
/$5E { POP SI ;Get S address}
/$1F { POP DS ;}
/$5A { POP DX ;X and Y}
/$FE/$C2 { INC DL ;X + 1}
/$52 { PUSH DX ;Save X and Y}
/$1E { PUSH DS}
/$56 { PUSH SI}
/$51 { PUSH CX}
/$CD/$10 { INT $10 ;Call BIOS}
/$B4/$09 { MOV AH,9 ;BIOS Display character}
/$59 { POP CX}
/$5E { POP SI ;Get S address}
/$1F { POP DS ;}
/$AC { LODSB ;Next character into AL}
/$1E { PUSH DS ;Save S address}
/$56 { PUSH SI ;}
/$51 { PUSH CX ;Length left to do}
/$B7/$00 { MOV BH,0 ;Display page zero}
/$8A/$5E/<Color { MOV BL,[BP+<Color] ;AH = Attribute}
/$B9/$01/$00 { MOV CX,1 ;One character}
/$CD/$10 { INT $10 ;Call BIOS}
/$59 { POP CX ;Get back length}
/$E2/$D9 { LOOP Bios1}
{; ;Remove stuff left on stack}
/$5E { POP SI}
/$1F { POP DS}
/$5A { POP DX}
{;}
/$1F {Exit: POP DS ;Restore DS}
);
(* Unfreeze screen in DoubleDos *)
IF ( MultiTasker = DoubleDos ) THEN
TurnOnTimeSharing
(* Synchronize screen for TopView *)
ELSE IF ( MultiTasker = TopView ) THEN
Sync_Screen( ( ( Y - 1 ) * 80 + X ) SHL 1 - 1 , ORD( S[0] ) );
END (* WriteSXY *);
